home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Toolbox classes / Dialog+ < prev    next >
Text File  |  1998-12-19  |  8KB  |  348 lines
  1. \ Dialog+ - MRH April 87.
  2.  
  3. \ This subclass of Dialog implements modeless dialogs, popup menu support,
  4. \ and other things.
  5.  
  6. \ Nov  87 mrh    Added enabling and disabling of dialogs.
  7. \ July 91 mrh    Migrated some methods to Dialog (now in a module).
  8. \ Mar  95 mrh    Event handlers no longer return a boolean
  9.  
  10.  
  11. need    dialog
  12.  
  13. syscall DialogSelect
  14. syscall IsDialogEvent
  15. syscall TEActivate
  16. syscall TEDeactivate
  17. syscall TrackGoAway
  18. syscall    TETextBox
  19.  
  20.  
  21. objPtr    DLG-CHAIN    \ Head of chain of open dialogs.  When
  22.             \ DialogSelect returns TRUE, we search this
  23.             \ chain to find which which one was hit.
  24.  
  25. objPtr    ACTIVE_DLG
  26. objPtr    THIS_DLG    \ These 3 objPtrs will be set to class Dialog+.
  27.  
  28. var    DPTR        clear: dptr
  29.  
  30. handle    TEHDL
  31. \ This is a copy of the textH field of a dialog, if a dialog window
  32. \ is frontmost.  Nil otherwise.  This allows us to call TEidle in the
  33. \ main event loop when necessary, as required for the insertion point
  34. \ to blink.
  35.  
  36. handle    SaveTEhdl        \ Saves TEhdl while we're suspended
  37.  
  38. $ A0  constant    TEXTH_OFFS
  39.  
  40. : SET_TEHDL    \ ( wnd-ptr -- )
  41.         \ wnd-ptr is the (relative) address of the dialog's window,
  42.         \ which is the same as the address of the dialog record itself, 
  43.         \ as the window field comes first.  The corresponding
  44.         \ absolute address is contained in the ivar dlgPtr.
  45.  
  46.     textH_offs +  @  ?dup IF  put: teHdl  ELSE  clear: teHdl  THEN  ;
  47.  
  48.  
  49. :class  DIALOG+  super{ dialog }
  50. record
  51. {    ptr        F-LINK                \ Forward link - ^dlg
  52.     ptr        B-LINK                \ Backward link ditto
  53.     bool    ENABLED?
  54.     ptr        PUM-LINK            \ Link to any pop-up menus
  55. }
  56.  
  57. ' dlg-chain        set_to_class  dialog+
  58. ' active_dlg    set_to_class  dialog+
  59. ' this_dlg        set_to_class  dialog+
  60.  
  61.  
  62. :m F-LINK:    \ ( -- ^dlg )
  63.     get: f-link  ;m
  64.  
  65. \ ( ^dlg -- )
  66. :m SET-F-LINK:        put: f-link  ;m
  67. :m SET-B-LINK:        put: b-link  ;m
  68.  
  69. \ ( -- ^dlg )
  70. :m PUM-LINK:        get: PUM-link  ;m
  71. :m SET-PUM-LINK:    put: PUM-link  ;m
  72.  
  73.  
  74. :m GETNEW:
  75.     nil?: dlgPtr  0EXIT                \ Out if open already
  76.     dlg-chain  put: f-link
  77.     dlg-chain nilP =
  78.     NIF  ^base   set-b-link: dlg-chain  THEN
  79.     ^base -> dlg-chain   clear: b-link
  80.     getnew: super
  81.     get: dlgPtr  set_teHdl
  82.     0 -> actW  ;m            \ Front window is a dialog, not a Mops window
  83.  
  84.  
  85. :m CLOSE:
  86.     nil?: dlgPtr  ?EXIT                \ Out if closed already
  87.     nil?: f-link
  88.     NIF  get: b-link  get: f-link  set-b-link: dialog+  THEN
  89.     nil?: b-link
  90.     NIF        get: f-link  get: b-link  set-f-link: dialog+
  91.     ELSE    get: f-link  -> dlg-chain
  92.     THEN
  93.     clear: teHdl  nilP -> active_dlg  close: super  ;m
  94.  
  95. :m EXEC:        \ ( index -- )
  96.     get: enabled?  if  exec: super  else  drop  then   ;m
  97.  
  98. :m ENABLE:        true  put: enabled?  ;m
  99.  
  100. :m DISABLE:        false  put: enabled?  ;m
  101.  
  102. :m ENABLED?:    get: enabled?  ;m
  103.  
  104.  
  105. :m CLASSINIT:    enable: self   ;m
  106.  
  107. :m DUMP:
  108.     ^base  .h  3 spaces  nil?: dlgPtr  if  ." not "  then  ." open"
  109.     3 spaces  get: enabled?
  110.     if   ." enabled"   else   ." disabled"   then   cr
  111.     get: f-link ." f-link " .h  get: b-link ." b-link " .h
  112.     ."  dlgPtr "  get: dlgPtr .h  cr
  113.     dlg-chain ." dlg-chain " .h   ;m
  114.  
  115. ;class
  116.  
  117. \                =====================================
  118.  
  119. : FIND-DLG  { dlptr -- b }
  120.     dlg-chain -> this_dlg
  121.     BEGIN
  122.         this_dlg nilP =  IF  false  EXIT  THEN
  123.         dlgPtr: this_dlg  dlptr =
  124.         IF  true  EXIT  THEN
  125.         f-link: this_dlg  -> this_dlg
  126.     AGAIN  ;
  127.  
  128.  
  129. : DLGPORT        \ Sets the current grafport to the current dialog.
  130.     dlgPtr: this_dlg  setPort  ;
  131.  
  132.  
  133. 0    value    EXEC?
  134.  
  135. : MLD-EVT
  136.     fEvent  addr: dptr  addr: theItem
  137.     DialogSelect  0<>  -> exec?
  138.     get: dptr  find-dlg  0EXIT
  139.     exec?  0EXIT
  140.     get: theItem  1-  exec: this_dlg  ;
  141.  
  142.  
  143. : CLOSE-DLG        \ ( dlptr -- )
  144.     find-dlg  0exit
  145.     close: this_dlg  ;
  146.  
  147. : IS_DLG_EVT?    \ ( -- b )
  148.     fevent  IsDialogEvent  ;
  149.  
  150.  
  151. \ ?TEidle calls TEidle if a modeless dialog with a TE field is current.
  152. \ We have to do this at regular intervals in order to get the insertion
  153. \ point to blink.  If the call is needed, the handle TEhdl won't be nil,
  154. \ and will be a handle to the TE field.   We arrange for this word to be
  155. \ called regularly by having our handler for null events  make the call.
  156.  
  157. : ?TEIDLE
  158.     nil?: teHdl  ?EXIT
  159.     get: teHdl  TEidle  ;
  160.  
  161. : UPD-EV    appWind?  0EXIT  upd-evt  ;
  162.  
  163. : ACTV-EV    appWind?  0EXIT  actv-evt  ;
  164.  
  165. : NULL-EV    ?TEidle  null-evt  ;
  166.  
  167. : OS-EV        \ When the system sends us Suspend and Resume events, it doesn't
  168.             \ deactivate/activate any windows.  We have to handle it
  169.             \ ourselves.  Here we look after non-modal dialog windows.
  170.             \ Ordinary windows are handled by OS-EVT in file Event.
  171.     OS-evt
  172.     suspend?
  173.     IF    get: TEhdl  put: saveTEhdl
  174.         nil?: TEhdl
  175.         NIF  get: TEhdl  TEDeactivate  clear: TEhdl  THEN
  176.         EXIT
  177.     THEN
  178.     resume?
  179.     IF    get: saveTEhdl  put: TEhdl
  180.         nil?: TEhdl  NIF  get: TEhdl  TEActivate  THEN
  181.     THEN   ;
  182.  
  183.  
  184. : ERR    60 beep abort  ;
  185.  
  186. \ We set the drag limit for dialogs at the time the drag is done - this
  187. \ allows the screen size to change while a dialog is up!
  188.  
  189. rect  DRAG-LIMIT
  190.  
  191. : SET_DRAG-LIMIT
  192.     screenbits  put: drag-limit  10 10 inset: drag-limit  ;
  193.  
  194.  
  195. : ENB?        \ ( -- b )  Returns true if WND corresponds to an enabled 
  196.             \            dialog.
  197.     wnd  find-dlg  NIF  false  exit  THEN
  198.     enabled?: this_dlg  ;
  199.  
  200. : ?SELECT    \ Selects the dialog corresponding to WND, if enabled.
  201.     enb?  0EXIT
  202.     wnd  SelectWindow  ;
  203.  
  204. : ?DRAG        \ Drags the dialog (maybe only if enabled).
  205.     enb?  0EXIT                \ Include if you don't want disabled dlgs draggable
  206.     set_drag-limit
  207.     wnd  where: fEvent
  208.     addr: drag-limit  DragWindow  ;
  209.  
  210. : ?CLOSE    \ Handles a click in the close box if enabled.
  211.     enb?  0EXIT
  212.     wnd  dup
  213.     where: fEvent  TrackGoAway
  214.     IF  close-dlg  ELSE  drop  THEN  ;
  215.  
  216.  
  217. : MLD-MOUSE-EVT        \ ( rgn -- )
  218.     \ Handles a click on a dialog window that was not reported
  219.     \ as a dialog event.  It could be select, drag, grow or close.
  220.     \ If the dialog is not enabled, we ignore the click.
  221.     
  222.     SELECT{
  223.         3  IS{    ?select                            }END
  224.         4  IS{    ?drag                            }END
  225.         5  IS{    ( A dialog box can't grow! )     }END
  226.         6  IS{    ?close                            }END
  227.         DEFAULT{  err
  228.     }SELECT  ;
  229.  
  230.  
  231. : MOUSE-EVT+MLD        \ ( -- )
  232.     is_dlg_evt?  IF  MLD-evt  EXIT  THEN
  233.     when: fEvent  put: theMouse            \ update click interval
  234.     where: fEvent  find-window  -> wnd
  235.     wnd windowKind  2 =  ( Dialog window? )
  236.     IF        MLD-mouse-evt
  237.     ELSE    (mouse-evt)
  238.     THEN  ;
  239.  
  240.  
  241. : KEY-EVT+MLD        \ ( -- )
  242.     active_dlg  nilP =
  243.     NIF    key: active_dlg  0EXIT        \ out if already handled
  244.         mods: fEvent  $ 100 and
  245.         NIF  MLD-evt  EXIT  THEN
  246.     THEN
  247.     key-evt  ;
  248.  
  249.  
  250. : UPD-EVT+MLD        \ ( -- )
  251.     is_dlg_evt?
  252.     IF    MLD-evt
  253.         drawBold: this_dlg  EXIT
  254.     THEN
  255.     msg: fEvent  -> wnd
  256.     upd-ev  ;
  257.  
  258.  
  259. : ACTV-EVT+MLD        \ ( -- )
  260.     msg: fEvent  -> wnd
  261.     wnd windowKind  2 =
  262.     IF    mods: fEvent 01 and
  263.         IF                    \ activate
  264.             wnd set_TEhdl
  265.             msg: fEvent  find-dlg
  266.             IF        this_dlg -> active_dlg
  267.             ELSE    nilP -> active_dlg
  268.             THEN
  269.         ELSE                \ deactivate
  270.             clear: TEhdl  nilP -> active_dlg
  271.         THEN
  272.         is_dlg_evt?  IF  MLD-evt  EXIT  THEN
  273.     THEN
  274.     actv-ev  ;
  275.  
  276.  
  277. : +MODELESS
  278.     XTS{    null-ev            mouse-evt+mld    null-ev            key-evt+mld
  279.             null-ev            key-evt+mld        upd-evt+mld        disk-evt
  280.             actv-evt+mld    null-ev            null-ev            null-ev
  281.             null-ev            null-ev            null-ev            OS-ev
  282.             null-ev            null-ev            null-ev            null-ev
  283.             null-ev            null-ev            null-ev            HL-evt  }
  284.     put: fEvent
  285. \    ['] ?TEidle -> TEidle
  286.     sleepticks 0<  IF  20  ELSE  sleepticks  20 min  THEN
  287.     -> sleepticks  ;
  288.  
  289.  
  290. endload
  291.  
  292. \ TESTING:
  293.  
  294. \ ================== "MLD test" dialog box ==========================
  295.  
  296.     6    dialog+    D1        2 setbold: d1
  297.     4    dialog+    D2
  298.  
  299.  
  300. : QQQ        20 beep  ;
  301. : WWW         1 beep  ;
  302. : ZZZ        ." useritem hit" cr  ;
  303.  
  304.  
  305. : USER->TEMPRECT    \ ( hdl item# -- b )
  306.     swap  find-dlg
  307.     IF        itemHandle: this_dlg  drop  true
  308.     ELSE    ( item# )  drop  false
  309.     THEN  ;
  310.  
  311. PPC?
  312. [IF]
  313.  
  314. konst uppUserItemProcInfo
  315. :ppc_proc DRAW_USER  { -- }
  316.     user->tempRect
  317.     IF    " Hello"  tempRect 1 TETextBox
  318.         dropShadow: tempRect
  319.     THEN
  320. ;ppc_proc
  321.  
  322. [ELSE]
  323.  
  324. :proc  DRAW_USER
  325.     user->tempRect
  326.     IF    " Hello"  tempRect 1 TETextBox
  327.         dropShadow: tempRect
  328.     THEN
  329. ;proc
  330.  
  331. [THEN]
  332.  
  333.  
  334. : CLOSE1    close: d1  ;
  335. : CLOSE2    close: d2  ;
  336.  
  337. XTS{  qqq www close1 togitem  zzz  zzz  }    300  init: d1
  338. XTS{  qqq www close2  zzz                }    301  init: d2
  339.  
  340. : GO
  341.     " MLDtest.rsrc" openresfile        \ ***
  342.     +modeless
  343.     getnew: d1  getnew: d2
  344.     ['] draw_user dup 6 setUserProc: d1  dup 5 setUserProc: d1
  345.     4 setUserProc: d2  ;
  346.  
  347. : zz  close: d1  close: d2  -modeless  ;
  348.